home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue64 / Alfresco / TstAdlrU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-10-23  |  3.0 KB  |  123 lines
  1. {*********************************************************}
  2. {* TstAdlrU                                              *}
  3. {* Copyright (c) Julian M Bucknall 2000                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Algorithms Alfresco: Adler checksum routines          *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit TstAdlrU;
  14.  
  15. interface
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  19.   StdCtrls;
  20.  
  21. type
  22.   TForm1 = class(TForm)
  23.     Button1: TButton;
  24.     Label1: TLabel;
  25.     Label2: TLabel;
  26.     Label3: TLabel;
  27.     Label4: TLabel;
  28.     procedure Button1Click(Sender: TObject);
  29.   private
  30.     { Private declarations }
  31.   public
  32.     { Public declarations }
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.  
  38. implementation
  39.  
  40. {$R *.DFM}
  41.  
  42. function UpdateAdlerSimple(aAdler : longword;
  43.                        var aBuffer; aCount : integer) : longword;
  44. var
  45.   S1 : longword;
  46.   S2 : longword;
  47.   i  : integer;
  48.   Buffer : PChar;
  49. begin
  50.   S1 := aAdler and $FFFF;
  51.   S2 := aAdler shr 16;
  52.   Buffer := @aBuffer;
  53.   for i := 0 to pred(aCount) do begin
  54.     S1 := (S1 + ord(Buffer^)) mod 65521;
  55.     S2 := (S2 + S1) mod 65521;
  56.     inc(Buffer);
  57.   end;
  58.   Result := (S2 shl 16) or S1;
  59. end;
  60.  
  61. function UpdateAdler(aAdler : longword;
  62.                  var aBuffer; aCount : integer) : longword;
  63. var
  64.   S1 : longword;
  65.   S2 : longword;
  66.   i  : integer;
  67.   Buffer : PChar;
  68. begin
  69.   Assert(aCount <= 4096,
  70.          'the UpdateAdler routine has been optimized for buffers up to 4KB');
  71.   S1 := aAdler and $FFFF;
  72.   S2 := aAdler shr 16;
  73.   Buffer := @aBuffer;
  74.   for i := 0 to pred(aCount) do begin
  75.     inc(S1, ord(Buffer^));
  76.     inc(S2, S1);
  77.     inc(Buffer);
  78.   end;
  79.   S1 := S1 mod 65521;
  80.   S2 := S2 mod 65521;
  81.   Result := (S2 shl 16) or S1;
  82. end;
  83.  
  84.  
  85. procedure TForm1.Button1Click(Sender: TObject);
  86. var
  87.   i  : integer;
  88.   FS : TFileStream;
  89.   StartTime : longword;
  90.   BytesRead : integer;
  91.   Buffer    : array [0..4095] of byte;
  92.   Time1     : longword;
  93.   Time2     : longword;
  94.   Adler1    : longword;
  95.   Adler2    : longword;
  96. begin
  97.   Time1 := 0;
  98.   Time2 := 0;
  99.   Adler1 := 1;
  100.   Adler2 := 1;
  101.   FS := TFileStream.Create('c:\unsorted.dat', fmOpenRead);
  102.   try
  103.     BytesRead := FS.Read(Buffer, 4096);
  104.     while (BytesRead <> 0) do begin
  105.       StartTime := GetTickCount;
  106.       Adler1 := UpdateAdlerSimple(Adler1, Buffer, BytesRead);
  107.       inc(Time1, GetTickCount - StartTime);
  108.       StartTime := GetTickCount;
  109.       Adler2 := UpdateAdler(Adler2, Buffer, BytesRead);
  110.       inc(Time2, GetTickCount - StartTime);
  111.       BytesRead := FS.Read(Buffer, 4096);
  112.     end;
  113.   finally
  114.     FS.Free;
  115.   end;
  116.   Label3.Caption := IntToStr(Time1);
  117.   Label4.Caption := IntToStr(Time2);
  118.   Assert(Adler1 = Adler2,
  119.          'the adler checksums do not match');
  120. end;
  121.  
  122. end.
  123.